home *** CD-ROM | disk | FTP | other *** search
/ Fifty: Elektronik / FIFTY Elektronik (PS_Computer_Vertrieb).iso / ps8 / fty1017 / gepackt.exe / DISK2 / PLOTSRC.EXE / STRTOOL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-11-10  |  4.2 KB  |  196 lines
  1. Unit STRTOOL;
  2.  
  3. Interface
  4. Uses Dos;
  5.  
  6. type  Str3    =  String[3];
  7.       Str5    =  string[5];
  8.       Str8    =  string[8];
  9.       Str10   =  string[10];
  10.       Str15   =  string[15];
  11.       Str30   =  string[30];
  12.       Str40   =  string[40];
  13.       Str80   =  string[80];
  14.       Str64   =  string[64];
  15.       Str255  =  string[255];
  16.       CharSet =set of Char;
  17.  
  18. Const Alphas        : Charset = ['A'..'Z','a'..'z','0'..'9',
  19.                                  '-','$','#','&','_'];
  20.       Term : CharSet  =  [^E,^I,^M,^Q,^X,^Z,#27];
  21.       DOSseparators : Charset = ['/','\', ':','*','.'];
  22.       Esc = #27;
  23.       Nul = #0;
  24.  
  25. Procedure SetSearchEnvVar(Name:Str15);
  26.  
  27. Function SearchFile(F:PathStr):PathStr;
  28.  
  29. FUNCTION Center (satz : Str80;widh : Integer): Str80;
  30.  
  31. Procedure UPstr(Var S:String);
  32.  
  33. Function UpcaseStr(S : Str80) : Str80;
  34.  
  35. Function ConstStr(C : Char; N : Integer) : Str80;
  36.  
  37. Procedure ProcessFileName(var FilePath,FileName : PathStr);
  38.  
  39. function FileExists(Name: PathStr): Boolean;
  40.  
  41. function IsReadOnly(Name: PathStr): Boolean;
  42.  
  43. function PathExists(Name: PathStr): Boolean;
  44.  
  45. Procedure NormFname(Var D:PathStr);
  46.  
  47. Procedure RemoveSlash(Var P:PathStr);
  48.  
  49. Function RandomFileName(P:PathStr;Ext:ExtStr):PathStr;
  50.  
  51. implementation
  52.  
  53. Const Env_VarStr:Str15='GEDDY';
  54.  
  55. Procedure SetSearchEnvVar(Name:Str15);
  56. begin
  57.   UpStr(Name);
  58.   Env_VarStr:=Name;
  59. end;
  60.  
  61. Function SearchFile(F:PathStr):PathStr;
  62. Var Name :PathStr;
  63. begin
  64.   Name:=Fsearch(F,GetEnv(Env_VarStr));
  65.   If Name='' then SearchFile:=F else SearchFile:=Name;
  66. end;
  67.  
  68. FUNCTION Center (satz : Str80;widh : Integer): Str80;
  69.   VAR L,R,C,S  : BYTE;
  70.       temp     : String;
  71.   BEGIN  (*  Center  *)
  72.        IF length(satz)>widh THEN
  73.          Temp := satz
  74.          ELSE
  75.            BEGIN
  76.              Temp := satz;
  77.              C := length(satz);
  78.              S := widh-C;
  79.              L := S div 2;
  80.              R := L + (S mod 2);
  81.              FOR C := 1 TO L DO Temp := ' '+Temp;
  82.              FOR C := 1 TO R DO Temp := Temp+' ';
  83.            END;
  84.        Center := Temp;
  85.   END;  (*  Center  *)
  86.  
  87. Procedure UPstr(Var S:String);
  88. var
  89.   P : Integer;
  90. begin
  91.   for P := 1 to Length(S) do
  92.     S[P] := Upcase(S[P]);
  93. end;
  94.  
  95.  
  96. Function UpcaseStr(S : Str80) : Str80;
  97. (* Umwandlung in Großbuchstaben *)
  98. var
  99.   P : Integer;
  100. begin
  101.   for P := 1 to Length(S) do
  102.     S[P] := Upcase(S[P]);
  103.   UpcaseStr := S;
  104. end;
  105.  
  106. Function ConstStr(C : Char; N : Integer) : Str80;
  107. (* Erzeugt String mit N gleichen Zeichen *)
  108. var
  109.   S : string[80];
  110. begin
  111.   if N < 0 then N := 0;
  112.   If N>Pred(SizeOf(Str80)) then N:=Pred(Sizeof(Str80));
  113.   Fillchar(S[1],N,Byte(C));
  114.   S[0] := Chr(N);
  115.   ConstStr:=S;
  116. end;
  117.  
  118. procedure ProcessFileName(var FilePath,FileName : PathStr);
  119.  
  120. Const Backslash='\';
  121. var
  122.   TmpDir : Str64;
  123. begin
  124.   Tmpdir:=Filepath;
  125.   If (Length(tmpdir)>0) and (Tmpdir[length(Tmpdir)]<> Backslash) Then
  126.     Tmpdir:=Tmpdir+Backslash;
  127.   Filename:=Tmpdir+Filename;
  128. end;
  129.  
  130. function FileExists(Name: PathStr): Boolean;
  131. var
  132.   SR: SearchRec;
  133. begin
  134.   FindFirst(Name, 0, SR);
  135.   FileExists := (DosError = 0) and ((SR.Attr and Directory)=0);
  136. end;
  137.  
  138. function IsReadOnly(Name: PathStr): Boolean;
  139. var
  140.   SR: SearchRec;
  141. begin
  142.   FindFirst(Name, 0, SR);
  143.   IsReadOnly := (DosError = 0) and ((SR.Attr and ReadOnly)>0);
  144. end;
  145.  
  146. function PathExists(Name: PathStr): Boolean;
  147. var actualPath :PathStr;
  148. begin
  149.   Removeslash(Name);
  150.   {$I-}
  151.   GetDir(0,actualpath);
  152.   ChDir(Name);
  153.   PathExists:=Ioresult=0;
  154.   Chdir(actualpath);
  155.   If Ioresult=0 then Exit;
  156. end;
  157.  
  158. Procedure NormFname(Var D:PathStr);
  159. begin
  160.   D:=Fexpand(D);
  161.   Upstr(D);
  162.   RemoveSlash(D);
  163. end;
  164.  
  165. Procedure RemoveSlash(Var P:PathStr);
  166. begin
  167.   If (P[0]>#3)  and (P[Byte(P[0])]='\') then Dec(Byte(p[0]));
  168. end;
  169.  
  170. Function RandomCh:Char;
  171. Var I:Word;
  172. begin
  173.   I:=Random(36);
  174.   If I>25 then
  175.      RandomCh:=Chr(48-26+I)
  176.   else
  177.      RandomCh:=Chr(65+I);
  178. end;
  179.  
  180. Function RandomFileName(P:PathStr;Ext:ExtStr):PathStr;
  181. Var Name :Str64;
  182.     F    :File;
  183.     I    :Integer;
  184.     Err,Err1  :Word;
  185. begin
  186.   Repeat
  187.     Name:='$2345678'+Ext;
  188.     For I:=2 to 8 do Name[I]:=RandomCh;
  189.     ProcessFilename(P,Name);
  190.   until Not FileExists(Name);
  191.   RandomFileName:=Name;
  192. end;
  193.  
  194.  
  195. end.
  196.